home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
drawer.zip
/
DIALOG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
3KB
|
132 lines
unit Dialogs;
interface
uses MSGraph;
type
Prompter = object
r, c : word; { position }
ce : word; { size (in columns) }
prompt : string; { prompt string }
resp : string; { response string }
procedure Initialize( r, c, ce : word; p : string);
function Process: boolean;
function Response: string;
end;
procedure InitDialogManager( var vc : _VideoConfig );
implementation
uses Crt;
const
cx : word = 640 div 80;
cy : word = 350 div 25;
procedure InitDialogManager( var vc : _VideoConfig );
begin
cx := vc.numxpixels div 80;
cy := vc.numypixels div 25;
end;
procedure Prompter.Initialize( r, c, ce : word; p : string);
begin
self.r := r;
self.c := c;
self.ce := ce;
self.prompt := p;
end;
function printable( ch : char ) : boolean;
begin
printable := ch>=' ';
end;
function MyRead( var s : string; max : word ) : boolean;
const
NUL = chr(0);
BS = chr(8);
CR = chr(13);
ESC = chr(27);
BEL = chr(7);
var
ch : char;
begin
s := '';
repeat
write('_'+chr(8));
ch := Readkey;
case ch of
NUL : begin
ch := Readkey;
{ case ch of
end;
}
end;
BS : begin
if length(s)>0 then begin
write(' '+BS+BS);
s := copy(s, 1, length(s)-1);
end
else write(BEL);
end;
ESC : begin
MyRead := FALSE;
exit;
end;
CR : begin
MyRead := TRUE;
exit;
end;
else begin
if printable(ch) and (length(s)<max) then begin
write(ch);
s := s + ch
end;
end;
end;
until FALSE;
end;
function Prompter.Process : boolean;
var
numbytes : word;
x1, y1, x2, y2 : word;
bitmap : pointer;
begin
with self do begin
x1 := (c-1)*cx;
y1 := (r-1)*cy;
x2 := x1+(ce+3)*cx;
y2 := y1+5*cy;
numbytes := _ImageSize( x1, y1, x2, y2);
GetMem( bitmap, numbytes);
_GetImage( x1, y1, x2, y2, bitmap^);
_setcolor(0);
_rectangle( _GFILLINTERIOR, x1, y1, x2, y2);
_setcolor(255);
_SetLineStyle($FFFF);
_rectangle( _GBORDER, x1, y1, x2, y2);
_SetTextPosition( r+1, c+1);
_OutText( prompt );
_rectangle( _GBORDER, c*cx-3, (r+2)*cy-1, (c+ce+1)*cx+3, (r+3)*cy);
_SetTextPosition( r+3, c+1);
Process := MyRead( self.resp, ce);
_PutImage( x1, y1, bitmap^, _GPSET);
FreeMem( bitmap, numbytes);
end;
end;
function Prompter.Response : string;
begin
Response := self.Resp;
end;
begin
DirectVideo := FALSE;
end.